home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Mops 2.7 / Mops source / Asm Source / hashDic < prev    next >
Encoding:
Text File  |  1995-07-05  |  1.9 KB  |  108 lines  |  [TEXT/MSET]
  1. \ HashDic class.  A dictionary for the assembler.
  2.  
  3. : SET_OBJECT_CLASS    \ ( ^class ^obj -- )
  4.     6 -  reloc!  ;
  5.  
  6. : OBJMOVE  { ^obj addr \ ^cl -- }
  7.     ^obj >classCfa  -> ^cl
  8.     ^obj  obj>                    \ source
  9.     addr                        \ dest
  10.     ^obj  length: object  8 +    \ length
  11.     cmove
  12.     ^cl  addr 2+  reloc!  ;
  13.  
  14.  
  15. :class    WARRAY    super{ indexed-obj }  2 indexed
  16.  
  17. :m  AT:        \ ( index -- n )
  18.     inline{ ix w@}
  19.     ^elem2  w@  ;m
  20.  
  21. :m  TO:        \ ( n index -- )
  22.     inline{ ix w!}
  23.     ^elem2  w!  ;m
  24.  
  25. :m  +TO:    \ ( n index -- )
  26.     inline{ ix w+!}
  27.     ^elem2  w+!  ;m
  28.  
  29. :m -TO:        \ ( n index -- )
  30.     inline{ ix w-!}
  31.     ^elem2  w-!  ;m
  32.  
  33. :m ^ELEM:    \ ( index -- addr )
  34.     inline{ ix}
  35.     ^elem2  ;m
  36.  
  37. :m FILL:    \ ( value -- )  Fills all elements with value.
  38.     idxbase  limit 2*  bounds
  39.     ?DO  dup  i w!  2 +LOOP  drop  ;m
  40.  
  41. :m CLASSINIT:
  42.     0  fill: self  ;m
  43.  
  44. ;class
  45.  
  46.  
  47.     0    value    ^LINK
  48.     0    value    HSH
  49.  
  50. :class HASHDIC    super{ wArray }
  51.  
  52. record
  53. {    uint    MASK
  54.     dicaddr    STRT
  55.     dicaddr    POS
  56.     dicaddr    LIM
  57. }
  58.  
  59. :m SETMASK:    put: mask  ;m
  60.  
  61. :m STRT:    get: strt  ;m
  62. :m POS:        get: pos   ;m
  63.  
  64. :m ALLOT:        \ ( space -- )
  65.     here  dup  put: strt  put: pos
  66.     space reserve
  67.     here  put: lim  ;m
  68.  
  69. :m QUERY:  { strObj -- ^obj T  | -- F }
  70.  
  71.     get: [ strObj ] str255 hash  dup -> hsh
  72.     get: mask  and  ^elem: self  -> ^link
  73.     BEGIN
  74.         ^link w@ NIF  ( not found )  false  EXIT  THEN
  75.         ^link Wdisplace  dup -> ^link
  76.         2+ @  hsh =
  77.         IF  ( found )  ^link 6 + >obj  true  EXIT  THEN
  78.     AGAIN  ;m
  79.  
  80.  
  81. :m ENTER:  { ^obj strObj \ posn len -- b }
  82.     strObj  query: self
  83.     IF  ( in already - replace old value with new and return false )
  84.         drop   ^obj  ^link 6 +  objmove
  85.         false  EXIT
  86.     ELSE
  87.         get: pos  -> posn
  88.         ^obj length: object 8 +  -> len
  89.         posn len +  get: lim  >  abort" hashDic overflow"
  90.         posn ^link Wdispl!
  91.         0 posn w!        2 ++> posn
  92.         hsh posn !        4 ++> posn
  93.         ^obj posn objmove    len ++> posn
  94.         posn put: pos  true
  95.     THEN  ;m
  96.  
  97. :m DUMP:
  98.     ^base
  99.     get: lim  ^base -
  100.     dump  ;m
  101. ;class
  102.  
  103. endload
  104.  
  105. \ TEST:
  106.     string s
  107.     16 hashDic dd    15 setMask: dd  200 allot: dd
  108.